home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0028_Interesting Flaming Lines Graphic.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  1.1 KB  |  51 lines
  1. uses crt,gru;
  2.  
  3. var
  4.   workp:pointer; work:word;
  5.   timer:longint absolute $0040:$006c;
  6.   frame,t1,t2:longint;
  7.   i:word;
  8.   ox,oy:word;
  9.  
  10. procedure lineto(x,y,where:word;c:byte);
  11. begin
  12.   if(x=ox)and(y=oy)then exit;
  13.   line2(ox,oy,x,y,where,c);
  14.   ox:=x;
  15.   oy:=y;
  16. end;
  17.  
  18. begin
  19.   ox:=160; oy:=100;
  20.   getmem(workp,64000); work:=seg(workp^);
  21.   randomize;
  22.   setmode($13);
  23.   clear386(vidseg,0);
  24.   clear386(work,0);
  25.   frame:=0;
  26. {  for i:=1 to 199 do setpal(i,i div 4,20+i div 5,10+i div 6);}
  27. {  for i:=1 to 199 do setpal(i,10+i div 4,5+i div 6,i div 7);}
  28.   for i:=1 to 32 do
  29.   begin
  30.     setpal(i,(i shl 1)-1,0,0);
  31.     setpal(i+32,63,(i shl 1)-1,0);
  32.     setpal(i+64,63,63,(i shl 1)-1);
  33.     setpal(i+96,63,63,63);
  34.   end;
  35.   t1:=timer;
  36.   repeat
  37.     inc(frame);
  38.     lineto(succ(random(319)),succ(random(199)),work,succ(random(250)));
  39.     line2(0,199,319,199,work,0);
  40.     smooth(work);
  41.     flip386(work,vidseg);
  42.   until(keypressed)and(readkey=#27);
  43.   t2:=(timer-t1);
  44.   for t1:=0 to 110 do
  45.   begin
  46.     smooth(work);
  47.     flip386(work,vidseg);
  48.   end;
  49.   setmode($03);
  50.   writeln(round((frame*18.2)/t2),' fps.');
  51. end.